Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/nivb/mess.frm

Visual Basic Form | 1995-05-07 | 6.2 KB | 181 lines

VERSION 2.00
Begin Form MessForm
   Caption         =   "Message Services Test"
   ClientHeight    =   2175
   ClientLeft      =   1710
   ClientTop       =   1575
   ClientWidth     =   5760
   Height          =   2580
   Left            =   1650
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   2175
   ScaleWidth      =   5760
   Top             =   1230
   Width           =   5880
   Begin ComboBox ServerNameBox
      Height          =   300
      Left            =   1200
      TabIndex        =   7
      Top             =   240
      Width           =   2535
   End
   Begin TextBox MessageBox
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   1680
      Width           =   4455
   End
   Begin ListBox UserNameBox
      Height          =   810
      Left            =   1200
      Sorted          =   -1  'True
      TabIndex        =   6
      Top             =   720
      Width           =   2535
   End
   Begin CommandButton CancelButton
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4320
      TabIndex        =   3
      Top             =   720
      Width           =   855
   End
   Begin CommandButton SendButton
      Caption         =   "Send"
      Default         =   -1  'True
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   240
      Width           =   855
   End
   Begin Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "Message:"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1680
      Width           =   855
   End
   Begin Label Label3
      Alignment       =   1  'Right Justify
      Caption         =   "User:"
      Height          =   255
      Left            =   600
      TabIndex        =   5
      Top             =   720
      Width           =   495
   End
   Begin Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "File Server:"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
Dim conns(MAX_CONNS) As Long
Dim results As String * MAX_CONNS
Sub Form_Unload (Cancel As Integer)
    SetPreferredConnectionID (originalPrefConnID%)
End Sub
Sub SendButton_Click ()
    Static results(MAX_CONNS) As Integer
    ccode% = GetConnectionID(ServerNameBox.Text, connID%)
    If (ccode% <> SUCCESSFUL) Then
        MsgBox "Unable to get connection ID of server " + prefServer$, MB_OK, "Error"
    Else
        SetPreferredConnectionID (connID%)
        userName$ = UserNameBox.Text
        If (Len(userName$) > 0) Then
            userName$ = Left$(userName$, InStr(userName$, " ") - 1)
            msgText$ = MessageBox.Text
            connNum& = Val(Mid$(UserNameBox.Text, InStr(UserNameBox.Text, "[") + 1))
            ccode% = SendBroadcastMessage(msgText$, connNum&, results(0), 1)
            If (ccode% <> SUCCESSFUL) Then
                MsgBox "Unable to send message to user " + userName$, MB_OK, "Error"
            Else
                Select Case (results(0) And &HFF)
                    Case &H0
                        MsgBox "Message sent to user " + userName$, MB_OK, "Message Sent"
                    Case &HFC
                        MsgBox userName$ + "'s message buffer is full", MB_OK, "Warning"
                    Case &HFD
                        MsgBox "Invalid connection number", MB_OK, "Error"
                    Case &HFF
                        MsgBox "User " + userName$ + " is blocking messages", MB_OK, "Warning"
                    Case Else
                        MsgBox "Unknown error while sending message", MB_OK, "Error"
                End Select
            End If
        End If
    End If
End Sub
Sub ServerNameBox_Change ()
    UpdateUserNameList
    SetMessageBoxText
End Sub
Sub ServerNameBox_Click ()
    UpdateUserNameList
    SetMessageBoxText
End Sub
Sub SetMessageBoxText ()
    Dim logTime As DATE_AND_TIME
    Dim oName As String * 48
    connNum& = GetConnectionNumber()
    ccode% = GetConnectionInformation(connNum&, oName, oType%, oID&, logTime)
    If (ccode% <> SUCCESSFUL) Then
        MsgBox "Unable to get user name for your connection", MB_OK, "Error"
    Else
        msgText$ = Left$(oName, InStr(oName, Chr$(0)) - 1)
        msgText$ = msgText$ + " [" + Format$(connNum&) + "]" + ":"
        MessageBox.Text = msgText$
    End If
End Sub
Sub UpdateUserNameList ()
    Dim oName As String * 48
    Dim serverInfo As FILE_SERV_INFO
    Dim logTime As DATE_AND_TIME
    ccode% = GetConnectionID(ServerNameBox.Text, connID%)
    If (ccode% <> SUCCESSFUL) Then
        MsgBox "Unable to get connection ID of user " + UserNameBox.Text, MB_OK, "Error"
    Else
        SetPreferredConnectionID (connID%)
        UserNameBox.Clear
        ccode% = GetServerInformation(54, serverInfo)
        If (ccode% <> SUCCESSFUL) Then
            MsgBox "Unable to get number of users supported from default file server", MB_OK, "Error"
        Else
            For conn& = 1 To (serverInfo.maxConnectionsSupported And 255)
                ccode% = GetConnectionInformation(conn&, oName, oType%, oID&, logTime)
                If ((ccode% = SUCCESSFUL) And (oType% = OT_USER)) Then
                    temp$ = Left$(oName, (InStr(oName, Chr$(0)) - 1))
                    temp$ = temp$ + " [" + Format$(conn&) + "]"
                    UserNameBox.AddItem temp$
                End If
            Next conn&
        End If
    End If
End Sub
Sub CancelButton_Click ()
    Unload MessForm
End Sub
Sub Form_Load ()
    Dim fileServerName As String * 48
    For connID% = 1 To 8
        If (IsConnectionIDInUse(connID%) = 1) Then
            GetFileServerName connID%, fileServerName
            ServerNameBox.AddItem fileServerName
        End If
    Next connID%
    fileServerName = GetDefaultFileServerName()
    ServerNameBox.Text = fileServerName
    Call UpdateUserNameList
    SetMessageBoxText
End Sub